MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 03 - 1987/03.07 Jul 87/pop up source/PaletteSample.p

Text File | 1986-12-18 | 10.6 KB | 420 lines | [TEXT/MPS ]

program PSample;
{Compiler Switch Settings}
{$R+}  {range checking on}
{$OV+} {overflow checking on}

uses
      {$U MemTypes.p } MemTypes,
      {$U QuickDraw.p} QuickDraw,
      {$U OsIntf.p   } OsIntf,
      {$U ToolIntf.p } ToolIntf,
      {$U UPalette.p } UPalette;

const
 AppleID = 1; {Menu ID for Apple menu}
 AboutItem = 1;{Item number for About... command}

 FileID = 2;       {Menu ID for File menu}
 NewWindowItem = 1;{Item number for New window command}
 QuitItem = 2;     {Item number for Quit command}

 MenuBarHeight = 21;

type
    PatRecord = record
        number: integer;
        thePattern: Pattern;
    end;

    PatRecPtr = ^PatRecord;
    PatRecHandle = ^PatRecPtr;

var
 AppleMenu : MenuHandle;
 FileMenu  : MenuHandle;

 theWindow : windowPtr; { the current front window }
 oldPort   : GrafPtr;   { temporary grafport info }
 theEvent  : EventRecord;

 systemPatterns : PatHandle; { handle to standard pattern list }

 currentPattern : Pattern; { new windows get this pattern }
 programDone    : Boolean; { true if Quit is selected }
 nextWindow     : Point;   { governs placement of new windows }
    currentPatNum : integer;
{---------------------------}


procedure SetUpMenus;
var
 { we need this cause the 'Apple'
  character isn't on the keyboard }
 appleTitle: String[1];

begin {SetUpMenus}

 { create Apple menu }
 appleTitle := ' ';
 appleTitle[1] := chr( appleMark );
 AppleMenu := NewMenu( AppleID,appleTitle );
 AppendMenu( AppleMenu, 'Sorry, just for looks…;(-' );
 InsertMenu( AppleMenu, 0 );

 { create File menu }
 FileMenu := NewMenu( FileID,'File' );
 AppendMenu( FileMenu,'New Window' );
 AppendMenu( FileMenu,'Quit' );
 InsertMenu( FileMenu, 0 );

 { put it up on the screen }
 DrawMenuBar;

end;  {SetUpMenus}

procedure MakeNewWindow;
 { Create a new window }
var
 r : Rect; { used for window size }
 aWindow : WindowPtr; { NewWindow returns a WindowPtr... }

begin
  { use 1/4 screen space for rectangle }
 with ScreenBits.bounds do
  begin
   r.top   := top + MenuBarHeight;{ ignore menu bar... }
   r.left  := left;
   r.bottom:= bottom div 2;
   r.right := right div 2;
  end;

 { offset placement of this window }
 nextWindow.v := nextWindow.v + 20;
 nextWindow.h := nextWindow.h + 20;

 { too far down? }
 if ( nextWindow.v + 20 > ScreenBits.bounds.bottom)
  then nextWindow.v := 20;

 { too far over? }
 if ( nextWindow.h + 20 > ScreenBits.bounds.right)
  then nextWindow.h := 20;

 { place the rect }
 OffSetRect( r, nextWindow.h , nextWindow.v );

 { create the window }
 aWindow := NewWindow( nil, r, 'Another Window',
            true, documentProc, pointer(-1), true,
            longint(0) );
 SetPort( aWindow );

 { force an update event for this window }
 InvalRect( thePort^.portRect );

 { create storage space for a pattern, and set it }
 WindowPeek( aWindow )^.refCon :=
       longint( NewHandle( SizeOf( PatRecord ) ) );
 PatRecHandle( WindowPeek( aWindow )^.refCon )^^.thePattern := currentPattern;
    PatRecHandle( WindowPeek( aWindow )^.refCon )^^.number := currentPatNum;

end; {MakeNewWindow}


procedure DestroyWindow( whichOne : WindowPtr );
 { We can't just do a DisposeWindow, because we are
  maintaining an extra block on the heap that contains
  the current pattern for each window.    We have to dispose
  of the block ourselves, because the WM doesn't know it's
  there.}
begin
 DisposHandle( handle( WindowPeek( whichOne )^.refCon ) );
 DisposeWindow( whichOne );
end; {DestroyWindow}

procedure DoMenuClick;
{  Handle mouse-down event in menu bar.  }
var
 menuChoice : longint; { returned by MenuSelect }
 theMenu : integer;  { ID of selected menu }
 theItem : integer;  { number of selected item }

begin
 menuChoice := MenuSelect( theEvent.where );

 { valid selection only if non-zero }
 if menuChoice <> 0 then
  begin
   theMenu := HiWord( menuChoice );
   theItem := LoWord( menuChoice );

   case theMenu of
    AppleID: { don't really do anything };

    { if they pick Quit, set global flag.
     if they pick New Window, go make one }
    FileID:  if theItem = QuitItem
             then programDone := true
             else if theItem = NewWindowItem
                  then MakeNewWindow;

   end;{ case theMenu… }

   { Unhighlight menu title }
   HiliteMenu( 0 );

  end; { if menuChoice… }

end;{DoMenuClick}

procedure DoInContent;
{ handle mouseclicks in a window }
var
 tempPatNum : integer; { temporary pattern number }
begin

 { this avoids inverting the "current selection"
  when popping-up the pattern }
 tempPatNum:=PatRecHandle( WindowPeek( theWindow )^.refCon )^^.number;

 { pop-up the palette, and let them select a pattern }
 PatternSelect( tempPatNum, theEvent.where );

 { a selection has been made only if tempPatNum has changed }
 if tempPatNum<>currentPatNum then
  begin

   { get the new pattern from the pattern list }
   GetIndPattern( currentPattern,sysPatListID,tempPatNum );
   currentPatNum := tempPatNum;

   {force an update for this window}
   InvalRect( thePort^.portRect );

  end; { if tempPatNum… }

 { set the pattern of the window }
 PatRecHandle( WindowPeek( theWindow )^.refCon )^^.thePattern := currentPattern;
 PatRecHandle( WindowPeek( theWindow )^.refCon )^^.number := currentPatNum;
end;{DoInContent}

procedure DoMouseDown;
{  Handle mouse-down events.  }
var
 whichWindow : WindowPtr; { window the mouse was pressed in }
 thePart : INTEGER; { part of screen where mouse was pressed }
 dragRect: Rect; { a window-sized rect for DragWindow }
 growVal: longint; { new size of window after GrowWindow }
 temp: Point;

begin

 { where on the screen was mouse pressed? }
 thePart := FindWindow( theEvent.where, whichWindow );

 case thePart of
  InDesk:      {Do nothing};
  InMenuBar:   DoMenuClick;
  InSysWindow:{Do nothing, cause there shouldn't be any};

  { if in top window then DoInContent, else make it the top window }
  InContent: if whichWindow <> theWindow
                                                        then SelectWindow( whichWindow )
              else DoInContent;

  { if not in top window then make it the top window,
    then do dragging }
  InDrag:  begin
            if whichWindow <> theWindow then SelectWindow( whichWindow );
            dragRect := screenBits.bounds;
            InsetRect( dragRect,4,4 );
            DragWindow( whichWindow, theEvent.where, dragRect );
           end;

  { if in grow box, resize window }
  InGrow: begin
           SetRect( dragRect, 20, 20, 512, 342 );
           growVal := GrowWindow( whichWindow, theEvent.where, dragRect );

          { if non-zero, change the size of the window }
          if ( growVal<>0 )
          then
           begin
            SizeWindow( whichWindow, LoWord( growVal ), HiWord( growVal ), true );
            InvalRect( thePort^.portRect );

            { erase the port to prepare for updating }
                                             FillRect( thePort^.portRect, white );
           end; { if ( growVal… }
         end;

  { if on go-away box, track till they let go }
  InGoAway: begin
             if TrackGoAway( theWindow, theEvent.where )
             then DestroyWindow( theWindow );
            end;
 end; {case}

 { make theWindow the current front window }
 theWindow := FrontWindow;

 { if there's a window up, do a SetPort }
 if FrontWindow <> NIL then SetPort( theWindow );

end; {DoMouseDown}

procedure DoUpdateEvent;
{ handle update events }
var
 whichWindow:WindowPtr; { target of update event }
 r:rect;                { temporary rect for clipping }

begin

 { get the window to be updated }
 whichWindow := WindowPtr( theEvent.message );

 { remember the current port before setting new port }
 GetPort( oldPort );
 SetPort( whichWindow );

 { make a rect as big as the grow box }
 r := thePort^.portRect;
 r.left := r.right - 15;
 r.top := r.bottom - 15;

 { set the visRgn to a collection of the update regions }
 BeginUpdate( whichWindow );

 { set the clip to the whole window,
   and erase the grow box spot }
 ClipRect( thePort^.portRect );
    FillRect( r, white) ;

 { draw the oval using the pattern pointed
   to by the window's refCon }
 FillOval( thePort^.portRect,
          PatRecHandle( WindowPeek( whichWindow )^.refCon )^^.thePattern );
    FrameOval( thePort^.portRect );

 { draw the grow box, but only if this is the front window }
 if FrontWindow = whichWindow
 then
  begin
  { clip to a rect barely as big as the grow box }
   ClipRect( r );

   DrawGrowIcon(whichWindow);

   { restore clip to be the whole window }
   ClipRect( thePort^.portRect );
  end;

 { restore the visRgn of the window }
 EndUpdate( whichWindow );

 { restore original port }
 SetPort( oldPort );

end; {DoUpdateEvt}

procedure DoActivateEvent;
{ handle activate and de-activate events }
var
 targetWindow:WindowPtr; { window being affected }
 r:rect;                 { temporary rect for clipping }

begin

 { get the window to be activated or de-activated }
 targetWindow := WindowPtr( theEvent.message );

 { remember the current port before setting new port }
 GetPort( oldPort );
 SetPort( targetWindow );

 { make a rect just as big as the grow box }
 r := thePort^.portRect;
 r.left := r.right - 15;
 r.top := r.bottom - 15;

 if Odd( theEvent.modifiers )
 then { it's an activation }
  begin

   { make it the top window }
   SelectWindow( targetWindow );

   { clip and draw the grow box }
   ClipRect( r );
   DrawGrowIcon( targetWindow );

   { restore the clip to the whole window }
   ClipRect( thePort^.portRect );
  end
 else { it's a de-activation }
  begin

   { Force an update of this window. Only the area
     occupied by the grow box will be updated }
   InvalRect( r );

   { restore the port }
   SetPort( oldPort ) ;

  end; { if Odd(… }
end; {DoActivateEvent}

begin{main}
 InitGraf( @ThePort );  { obligatory material goes here }
 InitFonts;
 InitWindows;
 InitMenus;           { <-- boring initialization code }
 TEInit;
 InitDialogs( NIL );
 InitCursor;

 { kick start the pop-up palette }
 InitPatternPalette;

 { go put up some menus }
 SetUpMenus;

 { load the system pattern list }
 systemPatterns := PatHandle( GetResource( 'PAT#', sysPatListID ) );

 currentPatNum := 1;
 { start currentPattern at black (pattern #1) }
 GetIndPattern( currentPattern, sysPatListID, 1 );

 { start window placement at 20,20 }
 SetPt( nextWindow, 20, 20 );

 { put up the first window, and make it 'theWindow' }
 MakeNewWindow;
 theWindow := FrontWindow;

 { this gets set to true when Quit command is selected }
 programDone := false;

 { here's the main event loop }
 repeat
 if GetNextEvent( everyEvent, theEvent ) then
  case theEvent.what of
   MouseDown:    DoMouseDown;
   UpdateEvt:    DoUpdateEvent;
   ActivateEvt:  DoActivateEvent;

   { if you're not handling an event,
     let the system have some time }
   otherwise  SystemTask;

  end; {case}
 until programDone;

    { now let's dispose of any windows still up }
    while FrontWindow <> NIL do
        DestroyWindow( FrontWindow );

end.